(in-package #:cl-fast-ecs/tests)


(define-test hooks
  :parent cl-fast-ecs)

(ecs::defhook :test)

(define-test hook
  :parent hooks
  (with-fixtures '(ecs::*test-hook*)
    (let ((hook-run-p nil))
      (labels ((test-fn ()
                 (setf hook-run-p t)))
        (hook-up ecs::*test-hook* #'test-fn)
        (is alexandria:length= 1 ecs::*test-hook*)

        (ecs::run-hook ecs::*test-hook*)
        (true hook-run-p)))))

(define-test unhook
  :parent hooks
  (with-fixtures '(ecs::*test-hook*)
    (hook-up ecs::*test-hook* #'car)
    (finish (unhook ecs::*test-hook* #'cdr))
    (is alexandria:length= 1 ecs::*test-hook*)

    (unhook ecs::*test-hook* #'car)
    (is alexandria:length= 0 ecs::*test-hook*)))

(define-test hook-parameters
  :parent hooks
  (with-fixtures '(ecs::*test-hook*)
    (let ((arg1 42)
          (arg2 '(1 2 3))
          (arg3 2.0))
      (labels ((test-fn (a b c)
                 (is = arg1 a)
                 (is equal arg2 b)
                 (is = arg3 c)))
        (hook-up ecs::*test-hook* #'test-fn)
        (ecs::run-hook ecs::*test-hook* arg1 arg2 arg3)))))

(define-test unhook-while-on-hook
  :parent hooks
  (labels ((test-fn ()
             (unhook ecs::*test-hook* #'test-fn))
           (test-fn2 ()
             (unhook ecs::*test-hook* #'test-fn2)))
    (hook-up ecs::*test-hook* #'test-fn)
    (hook-up ecs::*test-hook* #'test-fn2))
  (ecs::run-hook ecs::*test-hook*)
  (is alexandria:length= 0 ecs::*test-hook*))

#+sbcl
(define-test no-global-declaration-warning
  :parent hooks
  (finish
   (handler-case
       (eval
        '(hook-up ecs::*test-hook* #'car))
     (warning (w)
       (error (format nil "~a" w)))))
  (finish
   (handler-case
       (eval
        '(unhook ecs::*test-hook* #'car))
     (warning (w)
       (error (format nil "~a" w))))))
